home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 1
/
Cream of the Crop 1.iso
/
CAD
/
AC2VIV.ARJ
/
AC2VIV.LSP
< prev
next >
Wrap
Lisp/Scheme
|
1992-04-13
|
95KB
|
4,974 lines
;; AC2VIV 1.0
;;
;; AutoCAD R11 to VIVID 2.0 translator
;;
;; Copyright 1991, 1992 Roy Hirshkowitz, all rights reserved.
;;
;; Autocad and Autolisp are registered trademarks of Autodesk,Inc.
;; Vivid 2.0 is Copyright Stephen B. Coy, Vivid Software
;;
(princ "\nLoading Autocad to Vivid translator\n")
(regapp "VIVID_RJH") ;register extended entity app
(princ ".")
(defun c:ac2viv ()
;*************************************************************
;*
;* initialization- open files, initialize variables
;*
;**************************************************************
(setq temp (strcat (getstring "Output file: " ) ".v"))
(while (not (setq vivid_in (open temp "w")))
(princ (strcat "\nCannot open file " temp))
(setq temp (strcat (getstring "\nOutput file: " ) ".v"))
)
(textscr)
(princ "\n3d Entities Translated:\n")
(setq v_studio_list nil)
(setq start_time (getvar "date"))
;;DEBUGGING COUNTERS
(SETQ CTR1 0.0)
(SETQ CTR2 0.0)
(SETQ CTR3 0.0)
(SETQ CTR4 0.0)
(SETQ CTR5 0.0)
;; initialize counters used for statistical reporting
(setq main_count 0) ;3d drawing entity counter
(setq 3dface_count 0) ;3dfaces and
(setq 3dface_p_count 0) ; # of resulting VIVID polygons
(setq line_count 0) ;extruded lines
(setq 2dpoly_count 0) ;extruded 2d polylines and
(setq 2dpoly_p_count 0) ; # of resulting VIVID polygons
(setq 2dpoly_r_count 0) ; # of resulting VIVID rings
(setq 2dpoly_c_count 0) ; # of resulting VIVID cones
(setq circle_count 0) ;extruded circles & V_CONE?? blocks
(setq arc_count 0) ;extruded arcs and
(setq arc_c_count 0) ; # of resulting VIVID cones
(setq solid_count 0) ;solids and
(setq solid_p_count 0) ; # of resulting VIVID polygons
(setq sphere_count 0) ;v_sphere blocks (unit spheres)
(setq disk_count 0) ;v_disk blocks (unit rings)
;* smoothed meshes
(setq 3dmesh_count 0) ;# of 3d meshes and
(setq 3dmesh_p_count 0) ; # of resulting VIVID patches
(setq pface_count 0) ;polyface meshes and
(setq pface_p_count 0) ; # of resulting VIVID patches
;* faceted meshes
(setq f_3dmesh_count 0) ;# of 3d meshes and
(setq f_3dmesh_p_count 0) ; # of resulting VIVID polygons
(setq f_pface_count 0) ;polyface meshes and
(setq f_pface_p_count 0) ; # of resulting VIVID polygons
(setq light_count 0) ;# of lights
; build "master" list using layer table
;
(setq temp (tblnext "Layer" t))
(setq master (list))
(setq test1 1)
(while temp
(if (= (boole 1 (cdr (assoc 70 temp)) test1) 0)
(setq master (cons (list (cdr (assoc 2 temp)) (list " ")) master))
)
(setq temp (tblnext "Layer"))
)
;;
;; start light list
;;
(setq v_lights (list " "))
;***********************************************************************
;* end of initialization phase
;************************************************************************
;************************************************************
;*
;* Construction phase-- build tables (lists) using geometric info. from drawing
;*
;**************************************************************************
(v_main 0 (entnext) nil 1 nil nil)
;********************************************************************
;* End of construction phase
;********************************************************************
;***************************************************************
;*
;* Extraction phase-- write data to output file
;*
;****************************************************************
(princ "\nWriting information to output file.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; extract studio information-- use default value if none found
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; studio
(write-line "#include color.vc" vivid_in)
(write-line "studio = {" vivid_in)
(setq pt1 (trans (getvar "target") 1 0))
(setq pt2 (mapcar '+ pt1 (trans (getvar "viewdir") 1 0 T)))
(write-line
(strcat
"at "
(rtos (car pt1) 2 6)
" "
(rtos (cadr pt1) 2 6)
" "
(rtos (caddr pt1) 2 6)
" "
)
vivid_in
)
(write-line
(strcat
"from "
(rtos (car pt2) 2 6)
" "
(rtos (cadr pt2) 2 6)
" "
(rtos (caddr pt2) 2 6)
" "
)
vivid_in
)
;; derive field of view from lenslength (angle = 50/lenslength * 35)
(write-line
(strcat
"angle ="
(rtos (* (/ 50.00 (getvar "lenslength")) 35) 2 2)
" "
)
vivid_in
)
;; see if v_studio block was found in drawing-- if not use defaults
(if (not v_studio_list)
(progn
(write-line "up = 0 0 1;" vivid_in)
(write-line "resolution = 1024 768;" vivid_in)
(write-line "aspect = 1.3333;" vivid_in)
(write-line "ambient = .2 .2 .2;" vivid_in)
(write-line "background = sky_blue;" vivid_in)
(write-line "antialias = adaptive;" vivid_in)
(write-line "depth=4" vivid_in)
)
(foreach n v_studio_list (write-line n vivid_in))
)
(write-line "}" vivid_in)
;:::::::::::::::::::::::::::::::::::::::::::
;; extract information for "light" structures
(foreach n (reverse v_lights) (write-line n vivid_in))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; extract information from master list and write to file
(setq temp master)
(setq temp1 (car master))
(while temp1
(if (cdadr temp1)
(progn
(write-line (strcat
"#include "
(car temp1)
".vs"
)
vivid_in
)
(foreach n (car (cdr temp1)) (write-line n vivid_in))
)
)
(setq temp (cdr temp))
(setq temp1 (car temp))
)
;; print statistical stuff
(princ "\n")
(prin1 3dface_count)
(princ " 3dfaces to ")
(prin1 3dface_p_count)
(princ " VIVID polygons")
(princ "\n")
(prin1 line_count)
(princ " extruded lines to VIVID polygons")
(princ "\n")
(prin1 2dpoly_count)
(princ " 2dPolylines to ")
(prin1 2dpoly_p_count)
(princ " VIVID polygons, ")
(prin1 2dpoly_r_count)
(princ " rings and ")
(prin1 2dpoly_c_count)
(princ " cones")
(princ "\n")
(prin1 circle_count)
(princ " extruded circles & V_Cone blocks to VIVID cones")
(princ "\n")
(prin1 arc_count)
(princ " extruded arcs to ")
(prin1 arc_c_count)
(princ " VIVID cones")
(princ "\n")
(prin1 solid_count)
(princ " solids to ")
(prin1 solid_p_count)
(princ " VIVID polygons")
(princ "\n")
(prin1 sphere_count)
(princ " V_Sphere blocks to VIVID spheres")
(princ "\n")
(prin1 disk_count)
(princ " V_Disk blocks to VIVID rings")
(princ "\n")
(prin1 3dmesh_count)
(princ " 3dmeshes to ")
(prin1 3dmesh_p_count)
(princ " VIVID patches")
(princ "\n")
(prin1 pface_count)
(princ " polyface meshes to ")
(prin1 pface_p_count)
(princ " VIVID patches")
(princ "\n")
(prin1 f_3dmesh_count)
(princ " 3dmeshes to ")
(prin1 f_3dmesh_p_count)
(princ " VIVID polygons")
(princ "\n")
(prin1 f_pface_count)
(princ " polyface meshes to ")
(prin1 f_pface_p_count)
(princ " VIVID polygons")
(princ "\n")
(prin1 light_count)
(princ " light sources")
(close vivid_in)
;; calculate and display translation time.
(setq end_time (getvar "date"))
(setq seconds (* 86400.0 (- end_time start_time)))
(setq minutes (fix (/ seconds 60.0) ))
(setq seconds (fix (+ (rem seconds 60.0) 0.5)))
(princ "\n")
(princ "Translation time: ")
(prin1 minutes)
(princ " minutes, ")
(prin1 seconds)
(princ " seconds.")
(princ)
)
;***********************************************************************
;* END OF C:VIVID-- SUBROUTINES FOLLOW
;***********************************************************************
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; MAIN ROUTINE -- do single pass through entities extracting info.
;; and placing it in correct data structure for subsequent processing.
;; Primary data structure for geometric data is called "master" and consists
;; of a list whose elements are lists whose first elements are layer names
;; and second element is a list of strings (geometric data) to be output
;; to VIVID. Other data structures built by this routine include
;; a list of lights and a studios.
;;
;; Parameters--
;;
;; e -- ename of startin entity in list
;; b_flag -- nesting count (for processing blocks)
;; trans_matrix -- MCS to WCS transform (for processing blocks, this is
;; "nil" if processing main entities.)
;; s_factor -- cumulative scale factor maintained for processing blocks
;; (This is useful for things like circle radii-- note that
;; it is strictly the "x" scale factor.
;;
;; block_smooth -- T if all meshes within this block are to be
;; translated to patches rather than polygons.
;; Flag is set independently for nested blocks.
;;
;; block_layer -- contains layer name of block if this is a
;; block, nil otherwise. Used in place of layer
;; "0" for entities within blocks.
;;
;;
;; In order to process blocks and nested blocks this routine is called
;; recursively. If it is being called to process block entities it is
;; called with the b_flag parameter set to 1 or greater. This is necessary because
;; coordinates of block entities need to be further translated according
;; to position and scale of the particular insertion. (MCS to WCS transform)
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(princ ".")
(defun v_main (b_flag e trans_matrix s_factor block_smooth block_layer)
(while e
(setq s (entget e (list "VIVID_RJH")))
(cond
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 3dface
;; Since four points of face are not necessarily coplanar-- split
;; into triangles if necessary.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(
(and (= (cdr (assoc 0 s)) "3DFACE")
(check_layer block_layer)
)
(progn
(print_count)
(setq 3dface_count (1+ 3dface_count))
(setq 3dface_p_count (1+ 3dface_p_count))
(setq a (cdr (assoc 10 s)))
(setq b (cdr (assoc 11 s)))
(setq c (cdr (assoc 12 s)))
(setq d (cdr (assoc 13 s)))
(if (not (equal (cdr (assoc 13 s)) (cdr (assoc 12 s))))
;check to see if points are coplanar
(if (inters a c b d T)
(draw_4 a b c d trans_matrix)
(progn
(draw_3 a b c trans_matrix)
(draw_3 a c d trans_matrix)
(setq 3dface_p_count (1+ 3dface_p_count))
)
)
(draw_3 a b c trans_matrix)
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; extruded line
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(
(and (= (cdr (assoc 0 s)) "LINE")
(check_layer block_layer)
(and
(assoc 39 s)
(/= (cdr (assoc 39 s)) 0)
)
)
(progn
(print_count)
(setq line_count (1+ line_count))
; multiply thickness by extrusion vector
; and add to coordinates to obtain 3rd and 4th
; vertices of polygons
(setq a (cdr (assoc 10 s)))
(setq b (cdr (assoc 11 s)))
(setq ee (cdr (assoc 210 s)))
(setq ee (mapcar '(lambda (x)
(* x (cdr (assoc 39 s)))
)
ee
)
)
(setq c (mapcar '+ b ee))
(setq d (mapcar '+ a ee))
(draw_4 a b c d trans_matrix)
) ; close progn
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; extruded simple 2-d polylines -- not 3dmeshes
;;
;; routine has a complex organization because of the complexity of
;; the 2-d polyline entity. The entity can contain "wide" segments,
;; which need to be drawn whether or not the polyline is extruded. It
;; also can contain arcs, which can either be wide or skinny, extruded
;; or not extruded.
;;
;; At this time curve or spline fit polylines are not supported. Also
;; polyline arcs with variable widths will be translated to constant width
;; arcs (the starting width will be used). This particular item will be
;; corrected as soon as I can figure out how to do it with VIVID prims.
;;
;; All 2dpolys are pre-processed first. A segment list is built which
;; expands wide segments into four vertices. If we have encountered wide
;; segments, or if this polyline is thick (extruded), than it needs to be
;; drawn.
;;
;; The routine draw_poly then steps through this segment list. If one fat
;; (wide) segment is followed by another, and the angle which they define
;; differs from 180 degrees by some fixed tolerance, then the endpoints of
;; each fat segment are redefined. This should produce a result identical
;; to the way AutoCAD handles wide polys. Because of this, the first segment
;; of a closed polyline needs to be treated differently.
;;
;; Draw_poly calls draw_arc, draw_fat, or draw_skinny, depending on the segment
;; encountered.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(
(and (= (cdr (assoc 0 s)) "POLYLINE")
(check_layer block_layer)
(= 0 (boole 1 126 (cdr (assoc 70 s)))) ;2-d only --
;no splines or curves
)
(setq draw_this_poly? nil)
; * if polyline is thick (extruded) we definitely need
; * to draw it
(if (setq save_thickness (cdr (assoc 39 s)))
(setq draw_this_poly? T)
)
(pre_process_poly)
(if draw_this_poly?
(progn
(print_count)
(setq 2dpoly_count (1+ 2dpoly_count))
(draw_poly trans_matrix)
)
) ; close if
) ; close cond clause
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; solids-- may be extruded or flat.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(
(and (= (cdr (assoc 0 s)) "SOLID")
(check_layer block_layer)
)
(print_count)
(setq solid_count (1+ solid_count))
(setq a (cdr (assoc 10 s))
b (cdr (assoc 11 s))
c (cdr (assoc 12 s))
d (cdr (assoc 13 s))
)
(if (and (assoc 39 s)
(/= 0 (cdr (assoc 39 s)))
)
(setq ee
(list
0.0
0.0
(cdr (assoc 39 s))
)
)
(setq ee nil)
)
(if (equal c d)
;* triangular solid
(if ee
;* triangular prism
(progn
(setq a1 (trans (mapcar '+ a ee) (cdr (assoc 210 s)) 0 ))
(setq b1 (trans (mapcar '+ b ee) (cdr (assoc 210 s)) 0 ))
(setq c1 (trans (mapcar '+ c ee) (cdr (assoc 210 s)) 0 ))
(setq a (trans a (cdr (assoc 210 s)) 0))
(setq b (trans b (cdr (assoc 210 s)) 0))
(setq c (trans c (cdr (assoc 210 s)) 0))
(draw_3 a b c trans_matrix)
(draw_3 a1 b1 c1 trans_matrix)
(draw_4 a b b1 a1 trans_matrix)
(draw_4 b c c1 b1 trans_matrix)
(draw_4 c a a1 c1 trans_matrix)
(setq solid_p_count (+ 5 solid_p_count))
)
;* triangular face
(progn
(setq a (trans a (cdr (assoc 210 s)) 0))
(setq b (trans b (cdr (assoc 210 s)) 0))
(setq c (trans c (cdr (assoc 210 s)) 0))
(draw_3 a b c trans_matrix)
(setq solid_p_count (1+ solid_p_count))
)
) ; close if
(if (setq f (inters a c b d T))
;* bowtie here
(if ee
;* bowtie prism
(progn
(setq a1 (trans (mapcar '+ a ee) (cdr (assoc 210 s)) 0 ))
(setq b1 (trans (mapcar '+ b ee) (cdr (assoc 210 s)) 0 ))
(setq c1 (trans (mapcar '+ c ee) (cdr (assoc 210 s)) 0 ))
(setq d1 (trans (mapcar '+ d ee) (cdr (assoc 210 s)) 0 ))
(setq f1 (trans (mapcar '+ f ee) (cdr (assoc 210 s)) 0 ))
(setq a (trans a (cdr (assoc 210 s)) 0))
(setq b (trans b (cdr (assoc 210 s)) 0))
(setq c (trans c (cdr (assoc 210 s)) 0))
(setq d (trans d (cdr (assoc 210 s)) 0))
(setq f (trans f (cdr (assoc 210 s)) 0))
(draw_3 a b f trans_matrix)
(draw_3 a1 b1 f1 trans_matrix)
(draw_3 d c f trans_matrix)
(draw_3 d1 c1 f1 trans_matrix)
(draw_4 a b b1 a1 trans_matrix)
(draw_4 b d d1 b1 trans_matrix)
(draw_4 a c c1 a1 trans_matrix)
(draw_4 c d d1 c1 trans_matrix)
(setq solid_p_count (+ 8 solid_p_count))
)
;* bowtie face
(progn
(setq a (trans a (cdr (assoc 210 s)) 0))
(setq b (trans b (cdr (assoc 210 s)) 0))
(setq c (trans c (cdr (assoc 210 s)) 0))
(setq d (trans d (cdr (assoc 210 s)) 0))
(setq f (trans f (cdr (assoc 210 s)) 0))
(draw_3 a b f trans_matrix)
(draw_3 f d c trans_matrix)
(setq solid_p_count (+ 2 solid_p_count))
)
) ; close if
;* four sided here
(if ee
;* four-sided prism
(progn
(setq a1 (trans (mapcar '+ a ee) (cdr (assoc 210 s)) 0 ))
(setq b1 (trans (mapcar '+ b ee) (cdr (assoc 210 s)) 0 ))
(setq c1 (trans (mapcar '+ c ee) (cdr (assoc 210 s)) 0 ))
(setq d1 (trans (mapcar '+ d ee) (cdr (assoc 210 s)) 0 ))
(setq a (trans a (cdr (assoc 210 s)) 0))
(setq b (trans b (cdr (assoc 210 s)) 0))
(setq c (trans c (cdr (assoc 210 s)) 0))
(setq d (trans d (cdr (assoc 210 s)) 0))
(draw_4 a b d c trans_matrix)
(draw_4 a1 b1 d1 c1 trans_matrix)
(draw_4 a b b1 a1 trans_matrix)
(draw_4 b d d1 b1 trans_matrix)
(draw_4 d c c1 d1 trans_matrix)
(draw_4 c a a1 c1 trans_matrix)
(setq solid_p_count (+ 6 solid_p_count))
)
;* four-sided face
(progn
(setq a (trans a (cdr (assoc 210 s)) 0))
(setq b (trans b (cdr (assoc 210 s)) 0))
(setq c (trans c (cdr (assoc 210 s)) 0))
(setq d (trans d (cdr (assoc 210 s)) 0))
(draw_4 a b d c trans_matrix)
(setq solid_p_count (1+ solid_p_count))
)
) ; close if
) ;close if bowtie
) ;close if triangular
) ;close cond clause
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; extruded arcs-- convert to VIVID cones w/ clipping planes
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(
(and (= (cdr (assoc 0 s)) "ARC")
(check_layer block_layer)
(and
(assoc 39 s)
(/= (cdr (assoc 39 s)) 0)
)
)
(print_count)
(setq arc_count (1+ arc_count))
(setq arc_center (cdr (assoc 10 s)))
(setq radius1 (* (cdr (assoc 40 s)) s_factor))
(setq clip1_normal
(trans
(list
(- (sin (cdr (assoc 50 s))))
(cos (cdr (assoc 50 s)))
0.0
)
(cdr (assoc 210 s))
0
T
)
)
(if trans_matrix
(setq clip1_normal
(mapcar '-
(MCS_to_WCS clip1_normal trans_matrix)
(MCS_to_WCS (list 0 0 0) trans_matrix)
)
)
)
(setq clip2_normal
(trans
(list
(sin (cdr (assoc 51 s)))
(- (cos (cdr (assoc 51 s))))
0.0
)
(cdr (assoc 210 s))
0
T
)
)
(if trans_matrix
(setq clip2_normal
(mapcar '-
(MCS_to_WCS clip2_normal trans_matrix)
(MCS_to_WCS (list 0 0 0) trans_matrix)
)
)
)
(setq arc_center2
(trans
(mapcar '+
arc_center
(list 0 0 (cdr (assoc 39 s)))
)
(cdr (assoc 210 s))
0
)
)
(setq arc_center
(trans arc_center (cdr (assoc 210 s)) 0)
)
(if trans_matrix
(setq arc_center
(MCS_to_WCS arc_center trans_matrix)
arc_center2
(MCS_to_WCS arc_center2 trans_matrix)
)
)
(setq big_angle? nil)
;* if arc is greater than 180 degrees need to draw
;* two VIVID cones w/ clipping planes
(if (> (cdr (assoc 50 s))
(cdr (assoc 51 s))
)
(if (> (- (+ (* 2 pi) (cdr (assoc 51 s)))
(cdr (assoc 50 s))
)
pi
)
(setq big_angle? T)
) ; close if
(if (> (- (cdr (assoc 51 s))
(cdr (assoc 50 s))
)
pi
)
(setq big_angle? T)
) ; close if
); close if
(if big_angle?
(progn
(setq theta (+ (cdr (assoc 50 s)) pi ))
(setq clip3_normal
(trans
(list
(- (sin theta))
(cos theta)
0.0
)
(cdr (assoc 210 s))
0
T
)
)
(if trans_matrix
(setq clip3_normal
(mapcar '-
(MCS_to_WCS clip3_normal trans_matrix)
(MCS_to_WCS (list 0 0 0) trans_matrix)
)
)
)
(setq new
(cons
(car old)
(list
(append
(cadr old)
(list
" "
(strcat
"cone { base "
(real_to_string arc_center)
)
(strcat
"apex "
(real_to_string arc_center2)
)
(strcat "base_radius "
(rtos radius1 2 6)
)
(strcat "apex_radius "
(rtos radius1 2 6)
)
(strcat "clip { center "
(real_to_string arc_center)
" normal "
(real_to_string clip1_normal)
"}"
"}"
)
;* another cone
" "
(strcat
"cone { base "
(real_to_string arc_center)
)
(strcat
"apex "
(real_to_string arc_center2)
)
(strcat "base_radius "
(rtos radius1 2 6)
)
(strcat "apex_radius "
(rtos radius1 2 6)
)
(strcat "clip { center "
(real_to_string arc_center)
" normal "
(real_to_string clip2_normal)
"}"
)
(strcat "clip { center "
(real_to_string arc_center)
" normal "
(real_to_string clip3_normal)
"}"
"}"
)
) ; close list
) ; close append
) ; close list
) ; close cons
); close setq
(setq master (subst new old master))
(setq old new)
(setq arc_c_count (+ arc_c_count 2))
) ; close progn
(progn
(setq new
(cons
(car old)
(list
(append
(cadr old)
(list
" "
(strcat
"cone { base "
(real_to_string arc_center)
)
(strcat
"apex "
(real_to_string arc_center2)
)
(strcat "base_radius "
(rtos radius1 2 6)
)
(strcat "apex_radius "
(rtos radius1 2 6)
)
(strcat "clip { center "
(real_to_string arc_center)
" normal "
(real_to_string clip1_normal)
"}"
)
(strcat "clip { center "
(real_to_string arc_center)
" normal "
(real_to_string clip2_normal)
"}"
"}"
)
) ; close list
) ; close append
) ; close list
) ; close cons
); close setq
(setq master (subst new old master))
(setq old new)
(setq arc_c_count (1+ arc_c_count))
) ;close progn
) ; close if
) ; close cond clause
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 3d polygon mesh-- not polyface mesh.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(
(and (= (cdr (assoc 0 s)) "POLYLINE")
(= (boole 1 16 (cdr (assoc 70 s))) 16)
(= (boole 1 64 (cdr (assoc 70 s))) 0)
(check_layer block_layer)
)
(progn
;* increment either smoothed or faceted counter
(setq mesh_smooth (smooth_entity))
(if (smoothed)
(setq 3dmesh_count (1+ 3dmesh_count)
normal_index 0
)
(setq f_3dmesh_count (1+ f_3dmesh_count))
)
(print_count)
(draw_mesh trans_matrix)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; polyface mesh.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(
(and (= (cdr (assoc 0 s)) "POLYLINE")
(check_layer block_layer)
(= 64 (boole 1 64 (cdr (assoc 70 s))))
)
;* increment either smoothed or faceted counter
(setq mesh_smooth (smooth_entity))
(if (smoothed)
(setq pface_count (1+ pface_count)
normal_index 0
)
(setq f_pface_count (1+ f_pface_count))
)
(print_count)
(setq vertex_list (list nil))
(setq patch_list nil)
(setq normal_list nil)
(setq s (entget (setq e (entnext e)) (list "VIVID_RJH")))
(while (/= (cdr (assoc 0 s)) "SEQEND")
(cond
(
(= (boole 1 (cdr (assoc 70 s)) (+ 128 64)) 192)
;; this is a vertex -- add to list
(setq vertex_list (append vertex_list (list (cdr (assoc 10 s)))))
)
(
(= (boole 1 (cdr (assoc 70 s)) 128) 128)
;; this is a face vertex-- first determine
;; if it has less than three sides-- skip it if
;; it does. Then decide whether to draw a three
;; or four sided polygon. Use the previously
;; assembled vertices in vertex_list.
(if (/= 0 (cdr (assoc 73 s)))
(progn
(if (= 0 (cdr (assoc 74 s)))
;; triangular face here
(if (smoothed)
; smooth
(progn
(setq pface_p_count (1+ pface_p_count))
(add_patch
(nth (abs (cdr (assoc 71 s))) vertex_list)
(nth (abs (cdr (assoc 72 s))) vertex_list)
(nth (abs (cdr (assoc 73 s))) vertex_list)
trans_matrix
)
) ; close progn
;faceted
(progn
(setq f_pface_p_count (1+ f_pface_p_count))
(draw_3
(nth (abs (cdr (assoc 71 s))) vertex_list)
(nth (abs (cdr (assoc 72 s))) vertex_list)
(nth (abs (cdr (assoc 73 s))) vertex_list)
trans_matrix
)
) ; close progn
) ; close if
;; four sided here-- need to check
;; for coplanar vertices in faceted case
(if (smoothed)
; smooth
(progn
(add_patch
(nth (abs (cdr (assoc 71 s))) vertex_list)
(nth (abs (cdr (assoc 72 s))) vertex_list)
(nth (abs (cdr (assoc 73 s))) vertex_list)
trans_matrix
)
(add_patch
(nth (abs (cdr (assoc 71 s))) vertex_list)
(nth (abs (cdr (assoc 73 s))) vertex_list)
(nth (abs (cdr (assoc 74 s))) vertex_list)
trans_matrix
)
(setq pface_p_count (+ pface_p_count 2))
) ; close progn
;faceted
(if (inters
(nth (abs (cdr (assoc 71 s))) vertex_list)
(nth (abs (cdr (assoc 73 s))) vertex_list)
(nth (abs (cdr (assoc 72 s))) vertex_list)
(nth (abs (cdr (assoc 74 s))) vertex_list)
T
)
;co-planar
(progn
(draw_4
(nth (abs (cdr (assoc 71 s))) vertex_list)
(nth (abs (cdr (assoc 72 s))) vertex_list)
(nth (abs (cdr (assoc 73 s))) vertex_list)
(nth (abs (cdr (assoc 74 s))) vertex_list)
trans_matrix
)
(setq f_pface_p_count (1+ f_pface_p_count))
) ; close progn
;non-coplanar
(progn
(draw_3
(nth (abs (cdr (assoc 71 s))) vertex_list)
(nth (abs (cdr (assoc 72 s))) vertex_list)
(nth (abs (cdr (assoc 73 s))) vertex_list)
trans_matrix
)
(draw_3
(nth (abs (cdr (assoc 71 s))) vertex_list)
(nth (abs (cdr (assoc 73 s))) vertex_list)
(nth (abs (cdr (assoc 74 s))) vertex_list)
trans_matrix
)
(setq f_pface_p_count (+ f_pface_p_count 2))
) ; close progn
) ; close if
); close if
); close progn
); close if
)
) ;close cond clause
) ;close cond
(setq s (entget (setq e (entnext e)) (list "VIVID_RJH")))
) ;close while
(if (smoothed)
(progn
;(avg_normals)
(draw_patch)
)
)
) ;close cond clause
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; lights
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(
(and (= (cdr (assoc 0 s)) "INSERT")
(OR
(= (cdr (assoc 2 s)) "L_POINT")
(= (cdr (assoc 2 s)) "L_DIRECT")
(= (cdr (assoc 2 s)) "L_SPHERE")
(= (cdr (assoc 2 s)) "L_SPOT")
)
(check_layer block_layer) ;layer thawed and on
(= (cdr (assoc 66 s)) 1) ;attributes must follow
)
(progn
(setq light_count (1+ light_count))
(print_count)
(setq v_lights (cons "light={" v_lights))
(cond (
(= (cdr (assoc 2 s)) "L_POINT")
(setq v_lights (cons "type point;" v_lights))
)
(
(= (cdr (assoc 2 s)) "L_SPHERE")
(setq v_lights (cons "type spherical;" v_lights))
;; calculate radius based on scale
(setq v_lights (cons
(strcat
"radius "
(rtos
(abs (* (cdr (assoc 41 s)) s_factor))
2 6 ) ;close rtos
) ;close strcat
v_lights
) ;close cons
) ;close setq
)
(
(= (cdr (assoc 2 s)) "L_DIRECT")
(setq v_lights (cons "type directional;" v_lights))
)
(
(= (cdr (assoc 2 s)) "L_SPOT")
(setq v_lights (cons "type spot;" v_lights))
)
)
;;calculate position for point, sphericals, spot
(if (/= (cdr (assoc 2 s)) "L_DIRECT")
(progn
(if (= b_flag 0)
(setq temp1 (trans (cdr (assoc 10 s)) e 0)) ;translate to WCS
(setq temp1 (mcs_to_wcs (trans (cdr (assoc 10 s)) (cdr (assoc 210 s)) 0) trans_matrix))
)
(setq v_lights
(cons
(strcat
"position "
(rtos (car temp1) 2 6)
" "
(rtos (cadr temp1) 2 6)
" "
(rtos (caddr temp1) 2 6)
" "
)
v_lights
)
)
) ;close progn
) ;close if
(setq e (entnext e))
(setq s (entget e (list "VIVID_RJH")))
(while
(= (cdr (assoc 0 s)) "ATTRIB")
(if (or (= (cdr (assoc 2 s)) "NO_SHADOWS")
(= (cdr (assoc 2 s)) "NO_SPEC")
)
(if (or (= (cdr (assoc 1 s)) "Y")
(= (cdr (assoc 1 s)) "YES" )
(= (cdr (assoc 1 s)) "y" )
(= (cdr (assoc 1 s)) "yes" )
)
(setq v_lights (cons
(strcat
(strcase (cdr (assoc 2 s)) T)
" "
)
v_lights
)
)
) ; close if
(setq v_lights (cons
(strcat
(strcase (cdr (assoc 2 s)) T)
" "
(strcase (cdr (assoc 1 s)) T)
" "
)
v_lights
)
)
) ; close if
(setq e (entnext e))
(setq s (entget e (list "VIVID_RJH")))
)
(setq v_lights (cons "}" v_lights))
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; extruded circles-- convert to vivid cones (true cylinders)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(
(and (= (cdr (assoc 0 s)) "CIRCLE")
(check_layer block_layer)
(and
(assoc 39 s)
(/= (cdr (assoc 39 s)) 0)
)
)
(progn
(print_count)
(setq circle_count (1+ circle_count))
; multiply thickness by extrusion vector
; and add to coordinates to obtain 2nd center point
; first translate to WCS from ECS if not a block.
(if (= b_flag 0)
(setq a (trans (cdr (assoc 10 s)) e 0))
(setq a (trans (cdr (assoc 10 s)) (cdr (assoc 210 s)) 0))
)
(setq ee (cdr (assoc 210 s)))
(setq ee (mapcar '(lambda (x)
(* x (cdr (assoc 39 s)))
)
ee
)
)
(setq b (mapcar '+ a ee))
(setq c (rtos (* (cdr (assoc 40 s)) s_factor) 2 6 )) ;get radius
;; translate from MCS to WCS if this is a block
(if (> b_flag 0)
(progn
(setq a (MCS_to_WCS
a
trans_matrix))
(setq b (MCS_to_WCS
b
trans_matrix))
)
)
(setq new
(cons
(car old)
(list
(cons
(strcat
"cone {base "
(rtos (car a) 2 6)
" "
(rtos (cadr a) 2 6)
" "
(rtos (caddr a) 2 6)
" base_radius "
c
" apex "
(rtos (car b) 2 6)
" "
(rtos (cadr b) 2 6)
" "
(rtos (caddr b) 2 6)
" apex_radius "
c
"}"
)
(cadr old)
))
)
)
(setq master (subst new old master))
) ; close progn
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; V_CONE??-- convert to vivid cone w/ height = base_radius * ??
;; apex_radius = 0
;; searches for a block whose name starts w/ "V_CONE" and ends with
;; a valid number. The number is the cone height to radius ratio.
;; e.g. a V_CONE6 block converts to a cone whose height is 6 times
;; its radius (these are pointy cones-- apex_radius always = 0)
;;
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(
(and (= (cdr (assoc 0 s)) "INSERT")
(= (substr (cdr (assoc 2 s)) 1 6) "V_CONE")
(/= (setq cone_ratio (atof (substr (cdr (assoc 2 s)) 7))) 0.0)
(check_layer block_layer) ;layer thawed and on
)
(progn
(print_count)
(setq circle_count (1+ circle_count))
; multiply thickness by extrusion vector
; and add to coordinates to obtain 2nd center point
; first translate to WCS from ECS if not a block.
(if (= b_flag 0)
(setq a (trans (cdr (assoc 10 s)) e 0))
(setq a (trans (cdr (assoc 10 s)) (cdr (assoc 210 s)) 0))
)
(setq ee (cdr (assoc 210 s)))
(setq ee (mapcar '(lambda (x)
(* x (abs (cdr (assoc 41 s))) cone_ratio)
)
ee
)
)
(setq b (mapcar '+ a ee))
(setq c (rtos (* (abs (cdr (assoc 41 s))) s_factor) 2 6 )) ;get radius
;; translate from MCS to WCS if this is a block
(if (> b_flag 0)
(progn
(setq a (MCS_to_WCS
a
trans_matrix))
(setq b (MCS_to_WCS
b
trans_matrix))
)
)
(setq new
(cons
(car old)
(list
(cons
(strcat
"cone {base "
(rtos (car a) 2 6)
" "
(rtos (cadr a) 2 6)
" "
(rtos (caddr a) 2 6)
" base_radius "
c
" apex "
(rtos (car b) 2 6)
" "
(rtos (cadr b) 2 6)
" "
(rtos (caddr b) 2 6)
" apex_radius 0 "
"}"
)
(cadr old)
))
)
)
(setq master (subst new old master))
) ; close progn
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; spheres -- identified by block v_sphere-- unit sphere-- uses x scale
;; factor for radius.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(
(and (= (cdr (assoc 0 s)) "INSERT")
(= (cdr (assoc 2 s)) "V_SPHERE")
(check_layer block_layer) ;layer thawed and on
)
(progn
(print_count)
(setq sphere_count (1+ sphere_count))
; first translate to WCS from ECS or MCS (if a block)
(if (= b_flag 0)
(setq a (trans (cdr (assoc 10 s)) e 0))
(setq a (MCS_to_WCS (trans (cdr (assoc 10 s)) (cdr (assoc 210 s)) 0) trans_matrix))
)
(setq new
(cons
(car old)
(list
(cons
(strcat
"sphere {center "
(rtos (car a) 2 6)
" "
(rtos (cadr a) 2 6)
" "
(rtos (caddr a) 2 6)
" radius "
(rtos (* (abs (cdr (assoc 41 s))) s_factor) 2 6)
"}"
)
(cadr old)
))
)
)
(setq master (subst new old master))
) ; close progn
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; disks -- identified by block v_disk-- unit disk-- uses x scale
;; factor for radius.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(
(and (= (cdr (assoc 0 s)) "INSERT")
(= (cdr (assoc 2 s)) "V_DISK")
(check_layer block_layer) ;layer thawed and on
)
(progn
(print_count)
(setq disk_count (1+ disk_count))
; first translate to WCS from ECS or MCS (if a block)
(if (= b_flag 0)
(progn
(setq a (trans (cdr (assoc 10 s)) e 0))
(setq b (cdr (assoc 210 s)))
)
(progn
(setq a (MCS_to_WCS (trans (cdr (assoc 10 s)) (cdr (assoc 210 s)) 0) trans_matrix))
(setq b
(mapcar '-
(MCS_to_WCS (cdr (assoc 210 s)) trans_matrix)
(MCS_to_WCS '(0 0 0) trans_matrix)
)
)
)
)
(setq new
(cons
(car old)
(list
(cons
(strcat
"ring={center="
(rtos (car a) 2 6)
" "
(rtos (cadr a) 2 6)
" "
(rtos (caddr a) 2 6)
" radius "
(rtos (* (cdr (assoc 41 s)) s_factor) 2 6)
" normal "
(rtos (car b) 2 6)
" "
(rtos (cadr b) 2 6)
" "
(rtos (caddr b) 2 6)
" }"
)
(cadr old)
))
)
)
(setq master (subst new old master))
) ; close progn
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; half disks -- identified by block v_disk2-- unit disk w/ clipping
;; plane
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(
(and (= (cdr (assoc 0 s)) "INSERT")
(= (cdr (assoc 2 s)) "V_DISK2")
(check_layer block_layer) ;layer thawed and on
)
(progn
(print_count)
(setq disk_count (1+ disk_count))
; first translate to WCS from ECS or MCS (if a block)
(if (= b_flag 0)
(progn
(setq a (trans (cdr (assoc 10 s)) e 0))
(setq b (cdr (assoc 210 s)))
)
(progn
(setq a (MCS_to_WCS (trans (cdr (assoc 10 s)) (cdr (assoc 210 s)) 0) trans_matrix))
(setq b
(mapcar '-
(MCS_to_WCS (cdr (assoc 210 s)) trans_matrix)
(MCS_to_WCS '(0 0 0) trans_matrix)
)
); close setq
) ; close progn
); close if
;; rotate clipping normal about ECS origin if nec.
(if (/= 0 (setq theta (cdr (assoc 50 s))))
(setq clip_normal
(list
(cos theta)
(sin theta)
0
)
)
(setq clip_normal (list 1 0 0))
) ; close if
(setq clip_normal (trans clip_normal (cdr (assoc 210 s)) 0 T))
(if trans_matrix
(setq clip_normal
(mapcar '-
(MCS_to_WCS clip_normal trans_matrix)
(MCS_to_WCS '(0 0 0) trans_matrix)
)
); close setq
); close if
(setq new
(cons
(car old)
(list
(cons
(strcat
"ring {center "
(rtos (car a) 2 6)
" "
(rtos (cadr a) 2 6)
" "
(rtos (caddr a) 2 6)
" radius "
(rtos (* (cdr (assoc 41 s)) s_factor) 2 6)
" normal "
(rtos (car b) 2 6)
" "
(rtos (cadr b) 2 6)
" "
(rtos (caddr b) 2 6)
" "
) ;end strcat
(cons
(strcat
"clip {center "
(real_to_string a)
" normal "
(real_to_string clip_normal)
" }}"
) ; close strcat
(cadr old)
);close cons
) ;close cons
) ;close list
)
)
(setq master (subst new old master))
) ; close progn
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; "INSERT" (Block Insertion). Check to make sure that this
;; is a general purpose block-- e.g. that it is not one of the special
;; blocks whose names begin with "V_".
;;
;; General purpose blocks generate a recursive call to v_main so that the
;; entities within the block can be processed similarly to the main entities.
;; b_flag, a nesting indicator, is incremented before calling v_main.
;; V-main is also called with a transformation matrix to translate coordinates
;; from the block's coordinate system (MCS) to the WCS. This transformation
;; is based on the rotation angle, scale, and extrusion vector of the particular
;; INSERT. If this is a nested block, it will also be dependent on the
;; parent block's transformation matrix. If b_flag is non-zero, meaning we
;; are now processing a block-- the routines for processing each type of
;; entity in v_main will translate the coordinates by using the transformation
;; matrix. The matrix is a 4 x 4 matrix which is equivalent to AutoLISP's
;; matrix provided by (nentsel)-- (this is actually a 3 x 4 matrix-- an
;; additional row of 0 0 0 1 is provided to make matrix manipulation easier.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(
(and (= (cdr (assoc 0 s)) "INSERT")
(/= (substr (cdr (assoc 2 s)) 1 2) "V_")
(check_layer block_layer)
)
(progn
;; first determine if this INSERT has an extrusion vector other than 0 0 1.
;; if it does, transform according to the Arbitrary Axis Algorith documented
;; in Appendix C of the AutoCAD manual.
(if (equal (cdr (assoc 210 s)) '( 0 0 1))
(setq temp_matrix (list
(list 1 0 0 0)
(list 0 1 0 0)
(list 0 0 1 0)
(list 0 0 0 1)
)
)
;; implement arbitray axis algorithm
(progn
(if (and (< (abs (cadr (assoc 210 s))) (/ 1.0000 64))
(< (abs (caddr (assoc 210 s))) (/ 1.0000 64))
)
(setq x_axis (scale_to_1 (cross_p (list 0 1 0) (cdr (assoc 210 s)))))
(setq x_axis (scale_to_1 (cross_p (list 0 0 1) (cdr (assoc 210 s)))))
)
(setq temp_matrix
(list
(append x_axis (list 0))
(append (scale_to_1 (cross_p (cdr (assoc 210 s)) x_axis)) (list 0))
(append (cdr (assoc 210 s)) (list 0))
(list 0 0 0 1) (caddr (assoc 10 s))
)
)
) ;close progn
) ; close if
(setq temp_matrix (m_translate temp_matrix))
(setq temp_matrix (m_scale temp_matrix))
;; now determine if "INSERT" has been rotated. If it has apply the rotation
;; matrix.
(if (/= (cdr (assoc 50 s)) 0)
(setq temp_matrix (m_rotate temp_matrix (cdr (assoc 50 s))))
)
;; scale & translate
;;
;; now determine if this is a nested block-- e.g. if a transform exists already.
;; apply it if it does.
;;
(if trans_matrix
(setq temp_matrix (m_multiply trans_matrix temp_matrix))
)
;;
;; call v_main again with new parameters
;;
(v_main
(1+ b_flag)
(cdr (assoc -2 (tblsearch "block" (cdr (assoc 2 s)))))
temp_matrix
(* s_factor (abs (cdr (assoc 41 s))))
(smooth_entity)
(cdr (assoc 8 s))
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; studio structure -- only take first one encountered
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(
(and (= (cdr (assoc 0 s)) "INSERT")
(= (cdr (assoc 2 s)) "V_STUDIO")
(not v_studio_list) ;only one studio structure allowed
(check_layer block_layer) ;layer thawed and on
(= (cdr (assoc 66 s)) 1) ;attributes must follow
)
(progn
(setq e (entnext e))
(setq s (entget e (list "VIVID_RJH")))
(while
(= (cdr (assoc 0 s)) "ATTRIB")
(if (or (= (cdr (assoc 2 s)) "NO_EXP_TRANS")
(= (cdr (assoc 2 s)) "NO_SHADOWS")
(= (cdr (assoc 2 s)) "JITTER")
(= (cdr (assoc 2 s)) "CAUSTICS")
)
(if (or (= (cdr (assoc 1 s)) "Y")
(= (cdr (assoc 1 s)) "YES" )
(= (cdr (assoc 1 s)) "y" )
(= (cdr (assoc 1 s)) "yes" )
)
(setq v_studio_list
(cons
(strcat
(strcase (cdr (assoc 2 s)) T)
" "
)
v_studio_list
)
)
) ; close if
(setq v_studio_list
(cons
(strcat
(strcase (cdr (assoc 2 s)) T)
" "
(strcase (cdr (assoc 1 s)) T)
" "
)
v_studio_list
)
)
) ; close if
(setq e (entnext e))
(setq s (entget e (list "VIVID_RJH")))
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
) ;close cond
(setq e (entnext e)) ;get next element in list
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; end of v_main routine
;;
;; check_layer
;;
;; routine returns T if layer is thawed and on, nil otherwise. It determines
;; this by making sure it has an entry in the list "master". It also sets
;; the global variable "old" to this entry.
;;
;; layer "0" is treated differently-- if encountered an we are processing a
;; block-- the layer name used is the one for the block, not 0. This permits
;; processing of transparent blocks-- (needed for processing AME models)
;;
(princ ".")
(defun check_layer ( block_layer / temp)
(if (= (setq temp (strip_dependent (cdr (assoc 8 s)))) "0")
(if
block_layer
(setq old (assoc (strip_dependent block_layer) master))
(setq old (assoc "0" master))
)
(setq old (assoc temp master))
)
)
;*
;* strip_dependent
;*
;* strip out dependent layer stuff for xrefs-- only
;* use stuff to the right of last "|"
;*
;* if more than eight characters-- only take the first eight
;*
(princ ".")
(defun strip_dependent (layer1 / temp1 temp2 no_bar)
(setq temp1 (strlen layer1))
(setq no_bar T)
(while (and (> temp1 0)
no_bar
)
(if (= (substr layer1 temp1 1) "|")
(progn
(setq no_bar nil)
(setq temp2 (- (strlen layer1) temp1))
(if (> temp2 8)
(setq temp2 8)
)
)
(setq temp1 (1- temp1))
)
)
(if no_bar
(eval layer1)
(substr layer1 (1+ temp1) temp2)
)
)
;;
;;
;; Routine to draw "3dmesh". Mesh is represented as an array of M X N vertices.
;; Each mesh "box" may be four sided or three sided-- four sided boxes may not
;; be coplanar.
;;
;; Mesh is either translated into smooth patches or faceted polygons depending
;; on the states of variables block_smooth and mesh_smooth. If either is T
;; the mesh is smoothed.
;;
;;
(princ ".")
(defun draw_mesh (trans_matrix)
; first save 70 flag (to determine later if mesh is closed in M or N directions)
; and number of M, N.
(setq save_70 (cdr (assoc 70 s)))
(setq num_m (cdr (assoc 71 s)))
(setq save_m num_m)
(setq num_n (cdr (assoc 72 s)))
(setq save_n num_n)
(setq mesh_list (list nil))
(setq patch_list nil)
(setq normal_list nil)
(while (> num_m 0)
(setq n_list (list nil))
(while (> num_n 0)
(setq e (entnext e))
(setq s (entget e (list "VIVID_RJH")))
(setq n_list (cons (cdr (assoc 10 s)) n_list))
(setq num_n (1- num_n))
)
;; if mesh is closed in n direction add one additional point
(if (= (boole 1 32 save_70) 32)
(setq n_list (cons (nth (1- save_n) n_list) n_list))
)
(reverse n_list)
(setq mesh_list (cons n_list mesh_list))
(setq num_n save_n) ;restore N count
(setq num_m (1- num_m)) ;decrement M
)
;; if mesh is closed in m direction add one additional list
(if (= (boole 1 1 save_70) 1)
(progn
(setq mesh_list (cons (nth (1- save_m) mesh_list) mesh_list))
(setq save_m (1+ save_m)) ; increment for 1 element
)
)
;; if closed in n direction bump save_n to indicate additional element
(if (= (boole 1 32 save_70) 32)
(setq save_n (1+ save_n))
)
;; now read mesh_list
(setq num_m 0)
(setq num_n 0)
(reverse mesh_list)
(while (< num_m (1- save_m))
(while (< num_n (1- save_n))
(setq a (nth num_n (nth num_m mesh_list)))
(setq b (nth (1+ num_n) (nth num_m mesh_list)))
(setq c (nth (1+ num_n) (nth (1+ num_m) mesh_list)))
(setq d (nth num_n (nth (1+ num_m) mesh_list)))
(if (smoothed)
(triangulate a b c d trans_matrix)
(draw_3or4 a b c d trans_matrix)
)
(setq num_n (1+ num_n))
)
(setq num_n 0)
(setq num_m (1+ num_m))
)
(if (smoothed)
(progn
;(avg_normals)
; (SETQ DEBUG_START (GETVAR "DATE"))
(draw_patch)
; (SETQ DEBUG_END (GETVAR "DATE"))
; (SETQ CTR4 (+ CTR4 (* 86400.00 (- DEBUG_END DEBUG_START))))
)
)
)
;;
;; triangulate -- routine called by draw_mesh. Takes four points
;; of a polygon mesh "box" and breaks them into one or two triangular
;; patches. For smooth meshes only.
(princ ".")
(defun triangulate (a b c d trans_matrix)
(setq 3dmesh_p_count (1+ 3dmesh_p_count))
(if (equal a b 0.001)
(add_patch b c d trans_matrix)
(if (equal b c 0.001)
(add_patch c d a trans_matrix)
(if (equal c d 0.001)
(add_patch d a b trans_matrix)
(if (equal d a 0.001)
(add_patch a b c trans_matrix)
(progn
(setq 3dmesh_p_count (1+ 3dmesh_p_count))
(add_patch a b c trans_matrix)
(add_patch a c d trans_matrix)
)
)
)
)
)
)
;;
;; function draw_3or4 -- routine called by draw_mesh. Takes four points
;; of a polygon mesh "box" and determines if any two of the points are
;; identical. If they are, a three sides 3dmesh is drawn. If not the
;; routine determines if the four points are coplanar-- if they are a
;; four-sided 3dmesh is drawn-- if not the "mesh box" is split into two
;; triangular 3dmeshes. For faceted meshes only.
(princ ".")
(defun draw_3or4 (a b c d trans_matrix)
(setq f_3dmesh_p_count (1+ f_3dmesh_p_count))
(if (equal a b 0.001)
(draw_3 b c d trans_matrix)
(if (equal b c 0.001)
(draw_3 c d a trans_matrix)
(if (equal c d 0.001)
(draw_3 d a b trans_matrix)
(if (equal d a 0.001)
(draw_3 a b c trans_matrix)
(if
(inters a c b d T) ;are points coplanar?
(draw_4 a b c d trans_matrix)
(progn
(setq f_3dmesh_p_count (1+ f_3dmesh_p_count))
(draw_3 a b c trans_matrix)
(draw_3 a c d trans_matrix)
)
)
)
)
)
)
)
;;
;; draw_3 - routine adds 3 sided polygon to "master" structure
;;
(princ ".")
(defun draw_3 (a b c trans_matrix)
;; translate points first if this is a block
(if trans_matrix
(progn
(setq a (MCS_to_WCS a trans_matrix))
(setq b (MCS_to_WCS b trans_matrix))
(setq c (MCS_to_WCS c trans_matrix))
)
)
(setq new
(cons
(car old)
(list
(cons
(strcat
"polygon {points 3 vertex "
(rtos (car a) 2 6)
" "
(rtos (cadr a) 2 6)
" "
(rtos (caddr a) 2 6)
" vertex "
(rtos (car b) 2 6)
" "
(rtos (cadr b) 2 6)
" "
(rtos (caddr b) 2 6)
" vertex "
(rtos (car c) 2 6)
" "
(rtos (cadr c) 2 6)
" "
(rtos (caddr c) 2 6)
" }"
)
(cadr old)
))
)
)
(setq master (subst new old master))
(setq old new)
)
;;
;; draw_4 -- adds 4 sided polygon to "master" structure
;;
(princ ".")
(defun draw_4 (a b c d trans_matrix)
;; translate points first if this is a block.
(if
trans_matrix
(progn
(setq a (MCS_to_WCS a trans_matrix))
(setq b (MCS_to_WCS b trans_matrix))
(setq c (MCS_to_WCS c trans_matrix))
(setq d (MCS_to_WCS d trans_matrix))
)
)
(setq new
(cons
(car old)
(list
(cons
(strcat
"polygon {points 4 vertex "
(rtos (car a) 2 6)
" "
(rtos (cadr a) 2 6)
" "
(rtos (caddr a) 2 6)
" vertex "
(rtos (car b) 2 6)
" "
(rtos (cadr b) 2 6)
" "
(rtos (caddr b) 2 6)
" vertex "
(rtos (car c) 2 6)
" "
(rtos (cadr c) 2 6)
" "
(rtos (caddr c) 2 6)
" vertex "
(rtos (car d) 2 6)
" "
(rtos (cadr d) 2 6)
" "
(rtos (caddr d) 2 6)
" }"
)
(cadr old)
))
)
)
(setq master (subst new old master))
(setq old new)
)
;;
;; cross_p return a cross product of two vectors (u X v) expressed as three
;; element lists
;;
(princ ".")
(defun cross_p (u v)
(list
(- (* (nth 1 u) (nth 2 v)) (* (nth 1 v) (nth 2 u)))
(- (* (nth 2 u) (nth 0 v)) (* (nth 2 v) (nth 0 u)))
(- (* (nth 0 u) (nth 1 v)) (* (nth 0 v) (nth 1 u)))
)
)
;;
;; cell_i_j returns the value of a matrix element specified by (row i, col j)
;;
(princ ".")
(defun cell_i_j (matrix1 i j)
(nth (1- i) (nth (1- j) matrix1))
)
;;
;; dot_i_j returns the dot product of row (i), matrix1 and column (j), matrix2
;; this is an intermediate step in performing matrix multiplication.
;;
(princ ".")
(defun dot_i_j (matrix1 matrix2 i j)
(+
(* (cell_i_j matrix1 i 1) (cell_i_j matrix2 1 j))
(* (cell_i_j matrix1 i 2) (cell_i_j matrix2 2 j))
(* (cell_i_j matrix1 i 3) (cell_i_j matrix2 3 j))
(* (cell_i_j matrix1 i 4) (cell_i_j matrix2 4 j))
)
)
;;
;; m_multiply -- multiply matrix1 . matrix2-- (must be 4 x 4 matrices). Resulting
;; 4 x 4 matrix is returned and also stored globally in m_result.
;;
(princ ".")
(defun m_multiply (matrix1 matrix2 / col_count row_count col_list)
(setq m_result nil)
(setq col_count 1)
(while (<= col_count 4)
(setq col_list nil)
(setq row_count 1)
(while (<= row_count 4)
(setq col_list
(cons
(dot_i_j matrix1 matrix2 row_count col_count)
col_list
)
)
(setq row_count (1+ row_count))
)
(setq col_list (reverse col_list))
(setq m_result (cons col_list m_result))
(setq col_count (1+ col_count))
)
(setq m_result (reverse m_result))
)
;;
;; m_rotate- apply a rotational transform about the z axis to the specified matrix.
;; Returns transformed matrix-- uses m_multiply. Theta is in radians.
;;
;; This routine is used to rotate a block's coordinate system if the block has
;; either been inserted with a rotation angle or subsequently rotated about
;; its own z-axis. It is a piece of the process of translating from a block's
;; coordinate system to the WCS.
;;
(princ ".")
(defun m_rotate (matrix1 theta)
(m_multiply
;; rotational transform matrix
matrix1
(list
(list (cos theta) (sin theta) 0 0)
(list (- (sin theta)) (cos theta) 0 0)
(list 0 0 1 0)
(list 0 0 0 1)
)
;;
)
)
;;
;; m_scale -- apply scalar transform
;;
(princ ".")
(defun m_scale (matrix1)
(m_multiply
matrix1
(list
(list (cdr (assoc 41 s)) 0 0 0)
(list 0 (cdr (assoc 42 s)) 0 0)
(list 0 0 (cdr (assoc 43 s)) 0)
(list 0 0 0 1)
)
)
)
;;
;; m_translate -- apply translation transform
;;
(princ ".")
(defun m_translate (matrix1)
(m_multiply
matrix1
(list
(list 1 0 0 0)
(list 0 1 0 0)
(list 0 0 1 0)
(list (cadr (assoc 10 s))
(caddr (assoc 10 s))
(cadddr (assoc 10 s))
1
)
)
)
)
;;
;;
;; MCS_to_WCS - This routine transforms a single point from the coordinate
;; system of a block's entities (Model Coordinate System) to the WCS. It
;; works by making use of the transformation matrix constructed based on
;; a particular INSERT's extrusion vector, scale factors, and rotation angle--
;; plus the transformation matrix of the parent block if this is a child
;; (nested) block. (It is equivalent to the process described by AutoLISP's
;; nentsel command.) This matrix is passed to the main routine "v_main" as
;; a parameter "matrix1".
;;
;;
(princ ".")
(defun MCS_to_WCS (a matrix1)
(list
(+ (* (cell_i_j matrix1 1 1) (car a))
(* (cell_i_j matrix1 1 2) (cadr a))
(* (cell_i_j matrix1 1 3) (caddr a))
(cell_i_j matrix1 1 4)
)
(+ (* (cell_i_j matrix1 2 1) (car a))
(* (cell_i_j matrix1 2 2) (cadr a))
(* (cell_i_j matrix1 2 3) (caddr a))
(cell_i_j matrix1 2 4)
)
(+ (* (cell_i_j matrix1 3 1) (car a))
(* (cell_i_j matrix1 3 2) (cadr a))
(* (cell_i_j matrix1 3 3) (caddr a))
(cell_i_j matrix1 3 4)
)
)
)
;(defun MCS_to_WCS_n (a matrix1)
;
; (list
;
; (+ (* (cell_i_j matrix1 1 1) (car a))
; (* (cell_i_j matrix1 1 2) (cadr a))
; (* (cell_i_j matrix1 1 3) (caddr a))
;
; )
;
;
; (+ (* (cell_i_j matrix1 2 1) (car a))
; (* (cell_i_j matrix1 2 2) (cadr a))
; (* (cell_i_j matrix1 2 3) (caddr a))
;
; )
;
; (+ (* (cell_i_j matrix1 3 1) (car a))
; (* (cell_i_j matrix1 3 2) (cadr a))
; (* (cell_i_j matrix1 3 3) (caddr a))
;
; )
;
; )
;)
;
;
;;
;; scale_to_1 -- routine which will take an axis and scale it to unit length
;; if it is not already. This is part of implementing AutoCAD's Arbitrary
;; Axis Algorithm documented in Appendix C of the manual.
;;
(princ ".")
(defun scale_to_1 (axis)
(if (not (equal (setq temp (+
(* (car axis) (car axis))
(* (cadr axis) (cadr axis))
(* (caddr axis) (caddr axis))
)
)
1
0.0001
)
)
(progn (setq temp (sqrt (/ 1.000 temp)))
(list
(* (car axis) temp)
(* (cadr axis) temp)
(* (caddr axis) temp)
)
)
(setq temp axis)
)
)
;;
;; print_count -- prints entity counter and updates it
;;
(princ ".")
(defun print_count ()
(princ "\r")
(prin1 (setq main_count (1+ main_count)))
)
;;
;; add_patch add a triangular patch to the patch_list for later manipulation.
;; add surface normals for each vertex to normal_list
;; First translate from MCS to WCS if this is a block.
(princ ".")
(defun add_patch (a b c trans_matrix)
(if trans_matrix
(progn
(setq a (MCS_to_WCS a trans_matrix))
(setq b (MCS_to_WCS b trans_matrix))
(setq c (MCS_to_WCS c trans_matrix))
)
)
; (SETQ DEBUG_START (GETVAR "DATE"))
(setq normal1 (calc_normal a b c)) ;calculate surface normal
;; convert vertices to strings for use in association lists
(setq a (real_to_string a))
(setq b (real_to_string b))
(setq c (real_to_string c))
; (SETQ DEBUG_END (GETVAR "DATE"))
; (SETQ CTR1 (+ CTR1 (* 86400.00 (- DEBUG_END DEBUG_START))))
; (SETQ DEBUG_START (GETVAR "DATE"))
(setq patch_list
(cons
(list (add_normal a) (add_normal b) (add_normal c))
patch_list
)
)
; (SETQ DEBUG_END (GETVAR "DATE"))
; (SETQ CTR3 (+ CTR3 (* 86400.00 (- DEBUG_END DEBUG_START))))
)
;;
;; add_normal
;;
;; add a normal to the normal_list, a list which is keyed by vertex. If
;; a normal or normals are already present for this vertex, average in the new
;; normal (found in global variable "normal1") to the list.
;;
;;
(princ ".")
(defun add_normal (vertex / old_normals)
(if
(setq old_normals (assoc vertex normal_list))
;; vertex exists in normal list-- average in new normal, return
;; index value
(progn
(setq vertex_count (cadr old_normals))
(setq normal_list
(subst
(list
vertex
(1+ vertex_count)
(mapcar '(lambda (x y)
(/ (+ (* x vertex_count) y) (1+ vertex_count))
)
(caddr old_normals)
normal1
); close mapcar
(cadddr old_normals)
); close list
old_normals
normal_list
)
); close setq
(cadddr old_normals) ;return index value
); close progn
;; vertex not found, add to list w/ new index value
(progn
(setq normal_list
(cons (list vertex 1 normal1 normal_index) normal_list)
)
(setq normal_index (1+ normal_index))
(1- normal_index) ;return index value
) ; close progn
); close if
)
;;
;; calculate surface normal based on formula for plane
;;
(princ ".")
(defun calc_normal (a b c)
(list
(+ (* (cadr a) (- (caddr b) (caddr c)))
(* (cadr b) (- (caddr c) (caddr a)))
(* (cadr c) (- (caddr a) (caddr b)))
)
(+ (* (caddr a) (- (car b) (car c)))
(* (caddr b) (- (car c) (car a)))
(* (caddr c) (- (car a) (car b)))
)
(+ (* (car a) (- (cadr b) (cadr c)))
(* (car b) (- (cadr c) (cadr a)))
(* (car c) (- (cadr a) (cadr b)))
)
)
)
;;
;; avg_normals
;;
;; steps through normal_list which is a table of vertices and their assoc.
;; normals for a given mesh-- and averages them. At the conclusion of
;; the routine, normal_list is reconstructed with only one normal per
;; vertex (an average of the old ones)
;;
(princ ".")
(defun avg_normals (/ temp1 temp2 temp3)
(SETQ DEBUG_START (GETVAR "DATE"))
(setq temp1 normal_list)
(setq temp2 0)
(setq temp3 (length normal_list))
(while
(< temp2 temp3)
(if
(> 2 (length (car temp1))) ;skip if only one normal
(setq normal_list
(subst
(average (car temp1)) ;average norms
(car temp1)
normal_list
)
)
)
(setq temp1 (cdr temp1))
(setq temp2 (1+ temp2))
)
(SETQ DEBUG_END (GETVAR "DATE"))
(SETQ CTR2 (+ CTR2 (* 86400.00 (- DEBUG_END DEBUG_START))))
)
;;
;; average.
;;
;; average one element of normal_list. Each element consists of a vertex
;; key-- this is left unchanged-- followed by 2 or more normal vectors--
;; these are averaged.
;;
(princ ".")
(defun average (norms / temp1 temp2)
(setq temp2 (list 0 0 0))
(setq temp1 1)
;; first accumulate sum in temp2
(while
(< temp1 (length norms))
(setq temp2
(list
(+ (car temp2) (car (nth temp1 norms)))
(+ (cadr temp2) (cadr (nth temp1 norms)))
(+ (caddr temp2) (caddr (nth temp1 norms)))
)
)
(setq temp1 (1+ temp1))
)
;; now divide by number of norms
(setq norms
(list
(car norms)
(mapcar '(lambda (x)
(/ x (1- (length norms)))
)
temp2
)
)
)
)
;;
;; draw_patch
;;
;; step through patch_list and output each patch
;; write triangular patches with explicit surface normals to "master".
;;
(princ ".")
(defun draw_patch (/ temp1 temp2 temp3 patch)
(setq normal_list (reverse normal_list))
(setq temp1 (list " "))
(setq temp2 0)
(setq patch (nth temp2 patch_list))
(setq temp3 (length patch_list))
(repeat temp3
; (foreach patch patch_list
(setq temp1
(cons
(strcat
"patch {"
"vertex "
(car (nth (car patch) normal_list))
" normal "
(real_to_string (caddr (nth (car patch) normal_list)))
)
(cons
(strcat
"vertex "
(car (nth (cadr patch) normal_list))
" normal "
(real_to_string (caddr (nth (cadr patch) normal_list)))
)
(cons
(strcat
"vertex "
(car (nth (caddr patch) normal_list))
" normal "
(real_to_string (caddr (nth (caddr patch) normal_list)))
" }"
)
temp1
) ;close cons
); close cons
); close cons
) ; setq
(setq temp2 (1+ temp2))
(setq patch (nth temp2 patch_list))
) ; close repeat
; ) ; close foreach
(setq new
(cons (car old)
(list
(append
(cadr old)
temp1
)
)
)
) ; close setq
(setq master (subst new old master))
)
;;
;; real_to_string
;;
;; converts a set of 3 coordinate points to space delimited ascii using
;; AutoLISP's rtos function.
;;
(princ ".")
(defun real_to_string (real)
(strcat
(rtos (car real) 2 6)
" "
(rtos (cadr real) 2 6)
" "
(rtos (caddr real) 2 6)
" "
)
)
;;
;; smooth_entity
;;
;; Determine by searching extended entity data if "smooth" flag is set.
;; Return T or nil.
;;
(princ ".")
(defun smooth_entity (/ temp)
(if (setq temp (assoc -3 s))
(if (setq temp (assoc "VIVID_RJH" (cdr temp)))
(if (setq temp (assoc 1000 (cdr temp)))
(if (= (cdr temp) "smooth")
(eval T)
)
)
)
)
)
;;
;; smoothed
;;
;; returns T if either block_smooth or mesh_smooth flag is set,
;; nil otherwise
;;
(princ ".")
(defun smoothed ()
(or (eval block_smooth)
(eval mesh_smooth)
)
)
;;***** some additional AutoCAD commands
;**********************************************************************
;*
;* c:smooth AutoCAD command to tag either an insert or
;* mesh as "smooth". If a translator encounters
;* this tag, it will interpret either the mesh
;* or all the meshes within a block definition
;* as triangular patches with interpolated surface
;* normals @ coincident vertices.
;* Routine uses extended entity data and requires
;* R11 to work properly.
;* Nested blocks will not necessarily have the
;* same tag as parent blocks.
;*
;***********************************************************************
(defun c:smooth ()
(setq ss (ssget))
(setq temp1 0) ;count # smoothed
(setq temp 0) ;index into ss
(while (setq e (ssname ss temp))
(setq s (entget e (list "VIVID_RJH")))
;
; only operate on blocks, pface meshes, and 3d meshes.
;
(if
(or
(= (cdr (assoc 0 s)) "INSERT") ;block
(and (= (cdr (assoc 0 s)) "POLYLINE")
(or
(= 64 (boole 1 64 (cdr (assoc 70 s))))
(= 16 (boole 1 16 (cdr (assoc 70 s))))
)
)
)
(if (setq ex_list (assoc -3 s))
(if (setq app_list (assoc "VIVID_RJH" (cdr ex_list)))
;* application "VIVID_RJH" found here
(progn
(setq ed
(subst
(cons
(car ex_list)
(subst
(if (assoc 1000 (cdr app_list))
;* 1000 group exists
(cons
(car app_list)
(subst
(cons 1000 "smooth")
(assoc 1000 (cdr app_list))
(cdr app_list)
)
); close cons
;* 1000 group not found
(cons
(car app_list)
(cons (cons 1000 "smooth") (cdr app_list))
)
) ;close if
app_list
(cdr ex_list)
) ; close subst
) ; close cons
ex_list
s
); close subst
); close setq
(entmod ed)
(setq temp1 (1+ temp1)) ;incr. smoothed ctr.
) ; close progn
;* application "VIVID_RJH" not found
(progn
(entmod
(subst
(cons
(car ex_list)
(cons
(cons
"VIVID_RJH"
(list (cons 1000 "smooth"))
)
(cdr ex_list)
); close cons
); close cons
ex_list
s
); close subst
); close entmod
(setq temp1 (1+ temp1)) ;incr. smoothed ctr.
) ; close progn
); close if
;* no extended entity data here
(progn
(setq ed
(cons
(list
-3
(list
"VIVID_RJH"
(cons 1000 "smooth")
)
); close list
s
); close cons
); close setq
(entmod ed)
(setq temp1 (1+ temp1)) ; incr. counter
); close progn
) ; close if
); close if
(setq temp (1+ temp)) ;increment index into ss
); close while
;* print statistics
(princ "\n")
(prin1 temp1)
(princ " objects smoothed.")
(princ)
)
;**********************************************************************
;*
;* c:facet AutoCAD command to tag either an insert or
;* mesh as "faceted". Currentyly the translator
;* does not look specifically for this tag-- if it
;* does not find a "smooth" tag, the mesh or all
;* meshes within a block definition will be
;* translated as polygonally faceted surfaces.
;* Routine uses extended entity data and requires
;* R11 to work properly.
;* Nested blocks will not necessarily have the
;* same tag as parent blocks.
;*
;***********************************************************************
(defun c:facet ()
(setq ss (ssget))
(setq temp1 0) ;count # faceted
(setq temp 0) ;index into ss
(while (setq e (ssname ss temp))
(setq s (entget e (list "VIVID_RJH")))
;
; only operate on blocks, pface meshes, and 3d meshes.
;
(if
(or
(= (cdr (assoc 0 s)) "INSERT") ;block
(and (= (cdr (assoc 0 s)) "POLYLINE")
(or
(= 64 (boole 1 64 (cdr (assoc 70 s))))
(= 16 (boole 1 16 (cdr (assoc 70 s))))
)
)
)
(if (setq ex_list (assoc -3 s))
(if (setq app_list (assoc "VIVID_RJH" (cdr ex_list)))
;* application "VIVID_RJH" found here
(progn
(setq ed
(subst
(cons
(car ex_list)
(subst
(if (assoc 1000 (cdr app_list))
;* 1000 group exists
(cons
(car app_list)
(subst
(cons 1000 "facet")
(assoc 1000 (cdr app_list))
(cdr app_list)
)
); close cons
;* 1000 group not found
(cons
(car app_list)
(cons (cons 1000 "facet") (cdr app_list))
)
) ;close if
app_list
(cdr ex_list)
) ; close subst
) ; close cons
ex_list
s
); close subst
); close setq
(entmod ed)
(setq temp1 (1+ temp1)) ;incr. faceted ctr.
) ; close progn
;* application "VIVID_RJH" not found
(progn
(entmod
(subst
(cons
(car ex_list)
(cons
(cons
"VIVID_RJH"
(list (cons 1000 "facet"))
)
(cdr ex_list)
); close cons
); close cons
ex_list
s
); close subst
); close entmod
(setq temp1 (1+ temp1)) ;incr. faceted ctr.
) ; close progn
); close if
;* no extended entity data here
(progn
(setq ed
(cons
(list
-3
(list
"VIVID_RJH"
(cons 1000 "facet")
)
); close list
s
); close cons
); close setq
(entmod ed)
(setq temp1 (1+ temp1)) ; incr. counter
); close progn
) ; close if
); close if
(setq temp (1+ temp)) ;increment index into ss
); close while
;* print statistics
(princ "\n")
(prin1 temp1)
(princ " objects faceted.")
(princ)
)
;******************************************************************
;*
;* c:smooth? AutoCAD command to enquire if a block or mesh is
;* smoothed or not. Requires R11
;*
;*****************************************************************
(defun c:smooth? (/ temp )
(setq s (entget (car (entsel)) (list "VIVID_RJH")))
(setq temp nil)
(if (= (cdr (assoc 0 s)) "INSERT") ;block
(setq temp "block")
(if (and (= (cdr (assoc 0 s)) "POLYLINE")
(or
(= 64 (boole 1 64 (cdr (assoc 70 s))))
(= 16 (boole 1 16 (cdr (assoc 70 s))))
)
)
(setq temp "mesh")
(princ "\nEnitity is not a block or mesh.")
)
)
(while temp
(if (smooth_entity)
(progn
(princ "\n")
(princ "Entity is a smoothed ")
(princ temp)
)
(progn
(princ "\n")
(princ "Entity is a faceted ")
(princ temp)
)
)
(setq temp nil)
) ; close while
(princ)
)
;;
;; routine called by 2dpolyline handler-- steps through segment_list--
;; a list of the polyline segments and their attributes produced by the
;; preprocess_poly routine
;;
(defun draw_poly ( trans_matrix / index1 )
(setq index1 0)
(setq prev_segment nil)
(setq this_segment (nth index1 segment_list))
(setq next_segment (nth (1+ index1) segment_list))
;; first element in segment list needs to be processed differently
;; if this is a closed list & segment is fat
(if (and closed?
next_segment
(= (car this_segment) "fat" )
(= (car (last segment_list)) "fat" )
(not (equal (nth 3 this_segment) (nth 4 this_segment)))
(not (equal (nth 5 (last segment_list)) (nth 6 (last segment_list))))
)
(progn
(setq save_next next_segment)
(setq this_segment (last segment_list))
(setq next_segment this_segment)
(close_end trans_matrix)
(setq this_segment next_segment next_segment save_next)
)
(if (and save_thickness
(= (car this_segment) "fat")
)
(draw_end (nth 3 this_segment) (nth 4 this_segment) trans_matrix)
)
)
(while this_segment
;** fat segment?
(if (equal (car this_segment) "fat")
(progn
;*** check next segment to see if we need to close end
(if (and next_segment
(= (car next_segment) "fat")
(not (equal (nth 5 this_segment) (nth 6 this_segment)))
(not (equal (nth 3 next_segment) (nth 4 next_segment)))
)
(close_end trans_matrix)
(if save_thickness
(draw_end (nth 5 this_segment) (nth 6 this_segment) trans_matrix)
)
)
(draw_fat this_segment trans_matrix)
) ;close progn
(if (equal (car this_segment) "arc")
(draw_arc this_segment trans_matrix)
(if save_thickness
(draw_skinny this_segment trans_matrix)
)
)
); close if
(setq index1 (1+ index1))
(setq this_segment next_segment)
(setq next_segment (nth (1+ index1) segment_list))
) ; close while
) ; close defun
;;
;; close_end routine to close ends of fat polylines
;; results are written to global variables this_segment & next_segment
;;
(defun close_end (trans_matrix / a b )
;* is difference in angles > .05 radians (~3 degrees)
(if (> (abs
(-
(abs
(-
(angle (nth 1 this_segment) (nth 2 this_segment))
(/ pi 2.0)
)
)
(abs
(-
(angle (nth 1 next_segment) (nth 2 next_segment))
(/ pi 2.0)
)
)
)
)
0.05
)
;close end here
(progn
(setq a (inters
(nth 3 this_segment)
(nth 5 this_segment)
(nth 3 next_segment)
(nth 5 next_segment)
nil
)
)
(setq b (inters
(nth 4 this_segment)
(nth 6 this_segment)
(nth 4 next_segment)
(nth 6 next_segment)
nil
)
)
(setq this_segment
(list
(car this_segment)
(cadr this_segment)
(caddr this_segment)
(cadddr this_segment)
(nth 4 this_segment)
a
b
)
)
(setq next_segment
(list
(car next_segment)
(cadr next_segment)
(caddr next_segment)
a
b
(nth 5 next_segment)
(nth 6 next_segment)
)
)
) ; close progn
;; no need to close-- draw ends if thick
(if save_thickness
(progn
(draw_end (nth 5 this_segment) (nth 6 this_segment) trans_matrix)
(draw_end (nth 3 next_segment) (nth 4 next_segment) trans_matrix)
)
)
) ; close if
) ; close defun
;;
;;
;;
;
;
;
(defun draw_arc (segment1 trans_matrix / draw_this_arc?)
(setq draw_this_arc? T)
(if (or
save_thickness
(nth 4 segment1)
)
(progn
(get_arc_params
(cadr segment1)
(caddr segment1)
(cadddr segment1)
)
;** certain parameters can be translated now
(setq radius_len (* radius_len s_factor))
(setq clip1_normal (trans clip1_normal save_extrude 0 T))
(setq clip2_normal (trans clip2_normal save_extrude 0 T))
(if trans_matrix
(progn
(setq clip1_normal
(mapcar '-
(MCS_to_WCS clip1_normal trans_matrix)
(MCS_to_WCS (list 0 0 0) trans_matrix)
)
)
(setq clip2_normal
(mapcar '-
(MCS_to_WCS clip2_normal trans_matrix)
(MCS_to_WCS (list 0 0 0) trans_matrix)
)
)
); close progn
)
(setq s_arc_center
(real_to_string
(if trans_matrix
(PROGN
(MCS_to_WCS (trans
arc_center
save_extrude
0
)
trans_matrix
)
)
(trans arc_center save_extrude 0)
) ; close if
) ; close real_to_string
) ; close setq
(setq s_clip1
(strcat "clip { center "
s_arc_center
" normal "
(real_to_string clip1_normal)
"}"
)
)
(setq s_clip2
(strcat "clip { center "
s_arc_center
" normal "
(real_to_string clip2_normal)
"}"
)
)
) ; close progn
(setq draw_this_arc? nil)
) ; close if
(while draw_this_arc?
(if (and (setq width (nth 4 segment1))
(/= 0 width)
) ; wide arc?
(progn
(setq radius1 (- radius_len (/ (* width s_factor) 2.0)))
(setq radius2 (+ radius_len (/ (* width s_factor) 2.0)))
(if trans_matrix
(setq normal1
(mapcar '-
(MCS_to_WCS save_extrude trans_matrix)
(MCS_to_WCS '(0 0 0) trans_matrix)
)
)
(setq normal1 save_extrude)
)
(if save_thickness
(progn
;; wide and thick arc here
;; calculate and draw end rectangles
(setq v1 (cadr segment1))
(setq v2 (caddr segment1))
(setq v3 (list
(+
(car v1)
(- (cadr arc_center)
(cadr v1)
)
)
(+
(cadr v1)
(- (- (car arc_center)
(car v1)
))
)
(caddr v1)
) ; close list
) ;close setq
(setq v4 (list
(+
(car v2)
(- (cadr arc_center)
(cadr v2)
)
)
(+
(cadr v2)
(-(- (car arc_center)
(car v2)
))
)
(caddr v2)
) ; close list
) ;close setq
(setq temp (derive_wide v1 v3 width))
(setq a (car temp))
(setq a1 (list
(car a)
(cadr a)
(+ (caddr a) save_thickness)
)
)
(setq b (cadr temp))
(setq b1 (list
(car b)
(cadr b)
(+ (caddr b) save_thickness)
)
)
(setq a (trans a save_extrude 0))
(setq a1 (trans a1 save_extrude 0))
(setq b (trans b save_extrude 0))
(setq b1 (trans b1 save_extrude 0))
(setq temp (derive_wide v2 v4 width))
(setq c (car temp))
(setq c1 (list
(car c)
(cadr c)
(+ (caddr c) save_thickness)
)
)
(setq d (cadr temp))
(setq d1 (list
(car d)
(cadr d)
(+ (caddr d) save_thickness)
)
)
(setq c (trans c save_extrude 0))
(setq c1 (trans c1 save_extrude 0))
(setq d (trans d save_extrude 0))
(setq d1 (trans d1 save_extrude 0))
(draw_4 a b b1 a1 trans_matrix)
(draw_4 d c c1 d1 trans_matrix)
(setq arc_center2
(list
(car arc_center)
(cadr arc_center)
(+ (caddr arc_center) save_thickness)
)
)
(if trans_matrix
(setq arc_center2
(MCS_to_WCS
(trans arc_center2 save_extrude 0)
trans_matrix)
)
(setq arc_center2
(trans arc_center2 save_extrude 0)
)
)
;** save some strings for output
(setq s_arc_center2 (real_to_string arc_center2))
(setq new
(cons
(car old)
(list
(append
(cadr old)
(list
;* first ring
(strcat
"ring { center "
s_arc_center
)
(strcat "normal "
(real_to_string normal1 )
)
(strcat "min_radius "
(rtos radius1 2 6)
)
(strcat "max_radius "
(rtos radius2 2 6)
)
s_clip1
s_clip2
"}"
;* second ring
(strcat
"ring { center "
s_arc_center2
)
(strcat "normal "
(real_to_string normal1)
)
(strcat "min_radius "
(rtos radius1 2 6)
)
(strcat "max_radius "
(rtos radius2 2 6)
)
s_clip1
s_clip2
"}"
;* first cone
(strcat
"cone { base "
s_arc_center
)
(strcat
"apex "
s_arc_center2
)
(strcat "base_radius "
(rtos radius1 2 6)
)
(strcat "apex_radius "
(rtos radius1 2 6)
)
s_clip1
s_clip2
"}"
;* second cone
(strcat
"cone { base "
s_arc_center
)
(strcat "apex "
s_arc_center2
)
(strcat "base_radius "
(rtos radius2 2 6)
)
(strcat "apex_radius "
(rtos radius2 2 6)
)
s_clip1
s_clip2
"}"
) ;close list
) ;close append
) ;close list
) ;close cons
) ;close setq
(setq master (subst new old master))
(setq old new)
(setq draw_this_arc? nil)
(setq 2dpoly_p_count (+ 2 2dpoly_p_count))
(setq 2dpoly_c_count (+ 2 2dpoly_c_count))
(setq 2dpoly_r_count (+ 2 2dpoly_r_count))
) ; close progn
;;;;;;;** draw fat flat arc here
(progn
(setq new
(cons
(car old)
(list
(append
(cadr old)
(list
;* first ring
(strcat
"ring { center "
s_arc_center
)
(strcat "normal "
(real_to_string normal1 )
)
(strcat "min_radius "
(rtos radius1 2 6)
)
(strcat "max_radius "
(rtos radius2 2 6)
)
s_clip1
s_clip2
"}"
) ;close list
) ;close append
) ;close list
) ;close cons
) ;close setq
(setq master (subst new old master))
(setq old new)
(setq draw_this_arc? nil)
(setq 2dpoly_r_count (1+ 2dpoly_r_count))
) ; close progn
)
) ; close if
;;;;** draw extruded skinny arc here
(progn
;; need extruded center
(setq arc_center_2
(list
(car arc_center)
(cadr arc_center)
(+ (caddr arc_center save_thickness))
)
)
(setq arc_center_2 (trans arc_center_2 save_extrude 0))
(if trans_matrix
(setq arc_center_2 (MCS_to_WCS arc_center_2 trans_matrix))
)
(setq new
(cons
(car old)
(list
(append
(cadr old)
(list
;* first cone
(strcat
"cone { base "
s_arc_center
)
(strcat "apex "
(real_to_string arc_center_2)
)
(strcat "base_radius "
(rtos radius_len 2 6)
)
(strcat "apex_radius "
(rtos radius_len 2 6)
)
s_clip1
s_clip2
"}"
) ;close list
) ;close append
) ;close list
) ;close cons
) ;close setq
(setq master (subst new old master))
(setq old new)
(setq draw_this_arc? nil)
(setq 2dpoly_c_count (1+ 2dpoly_c_count))
) ; close progn
) ; close if
); close while
); close defun
;;
;; get_arc_params -- called by draw_arc
;;
;; input-- two vertices and a bulge (1/4 tangent of included angle)
;;
;; finds results of global variables as follows:
;;
;; radius_len -- length of radius
;; len_ratio -- ratio of segment length to radius
;; clip1_normal -- normal of 1st clipping plane
;; clip2_normal -- normal of 2nd clipping plane
(defun get_arc_params ( v1 v2 bulge / a b m r)
(setq theta (* 2.0 (atan bulge)))
(setq a (/ (distance v1 v2) 2.0))
(setq r (/ a (sin theta) ))
(setq radius_len (abs r))
(setq sign_r (/ r radius_len))
(setq b (* radius_len (cos theta)))
(setq len_ratio (/ b a))
(setq delta_x (- (car v2) (car v1)))
(setq delta_y (- (cadr v2) (cadr v1)))
(setq m (list
(+ (car v1) (/ delta_x 2.0))
(+ (cadr v1) (/ delta_y 2.0))
(caddr v1)
)
)
(setq arc_center (list
(+ (car m) (* (/ delta_y 2.0) (- sign_r) len_ratio))
(+ (cadr m) (* (/ (- delta_x) 2.0) (- sign_r) len_ratio))
(caddr m)
)
)
; (if (> (car v1) (car v2))
; (progn
; (setq v3 v2)
; (setq v2 v1)
; (setq v1 v3)
; )
; )
(setq delta_x_clip1 (if (> 0 bulge)
(- (car arc_center) (car v2))
(- (car v2) (car arc_center))
)
)
(setq delta_y_clip1 (if (> 0 bulge)
(- (cadr arc_center) (cadr v2))
(- (cadr v2) (cadr arc_center))
)
)
(setq m_clip1 (list
(+ (car v2) (/ delta_x_clip1 2.0))
(+ (cadr v2) (/ delta_y_clip1 2.0))
(caddr v2)
)
)
(setq e_clip1 (list
(+ (car m_clip1) delta_y_clip1)
(+ (cadr m_clip1) (- delta_x_clip1))
(caddr m_clip1)
)
)
(setq clip1_normal (list
(- (car e_clip1) (car m_clip1))
(- (cadr e_clip1) (cadr m_clip1))
0.0
)
)
(setq delta_x_clip2 (if (> 0 bulge)
(- (car arc_center) (car v1))
(- (car v1) (car arc_center))
)
)
(setq delta_y_clip2 (if (> 0 bulge)
(- (cadr arc_center) (cadr v1))
(- (cadr v1) (cadr arc_center))
)
)
(setq m_clip2 (list
(+ (car v1) (/ delta_x_clip2 2.0))
(+ (cadr v1) (/ delta_y_clip2 2.0))
(caddr v1)
)
)
(setq e_clip2 (list
(+ (car m_clip2) (- delta_y_clip2))
(+ (cadr m_clip2) delta_x_clip2)
(caddr m_clip2)
)
)
(setq clip2_normal (list
(- (car e_clip2) (car m_clip2))
(- (cadr e_clip2) (cadr m_clip2))
0.0
)
)
)
(defun draw_skinny (segment1 trans_matrix / a1 b1)
(setq a1
(trans
(list
(car (cadr segment1))
(cadr (cadr segment1))
(+ (caddr (cadr segment1)) save_thickness)
)
save_extrude
0
)
)
(setq b1
(trans
(list
(car (caddr segment1))
(cadr (caddr segment1))
(+ (caddr (caddr segment1)) save_thickness)
)
save_extrude
0
)
)
(setq a (trans (cadr segment1) save_extrude 0))
(setq b (trans (caddr segment1) save_extrude 0))
(draw_4 a b b1 a1 trans_matrix)
(setq 2dpoly_p_count (1+ 2dpoly_p_count))
)
(defun draw_fat (segment1 trans_matrix / a1 b1 c1 d1 )
(if save_thickness
;; thick and fat
(progn
(setq a1
(trans
(list
(car (nth 3 segment1))
(cadr (nth 3 segment1))
(+ (caddr (nth 3 segment1)) save_thickness)
)
save_extrude
0
)
)
(setq b1
(trans
(list
(car (nth 4 segment1))
(cadr (nth 4 segment1))
(+ (caddr (nth 4 segment1)) save_thickness)
)
save_extrude
0
)
)
(setq c1
(trans
(list
(car (nth 5 segment1))
(cadr (nth 5 segment1))
(+ (caddr (nth 5 segment1)) save_thickness)
)
save_extrude
0
)
)
(setq d1
(trans
(list
(car (nth 6 segment1))
(cadr (nth 6 segment1))
(+ (caddr (nth 6 segment1)) save_thickness)
)
save_extrude
0
)
)
(setq a (trans (nth 3 segment1) save_extrude 0))
(setq b (trans (nth 4 segment1) save_extrude 0))
(setq c (trans (nth 5 segment1) save_extrude 0))
(setq d (trans (nth 6 segment1) save_extrude 0))
(draw_4 a b d c trans_matrix)
(draw_4 a1 b1 d1 c1 trans_matrix)
(draw_4 a c c1 a1 trans_matrix)
(draw_4 b d d1 b1 trans_matrix)
(setq 2dpoly_p_count (+ 2dpoly_p_count 4))
) ;close progn
;; just fat -- trivial
(progn
(draw_4
(trans (nth 3 segment1) save_extrude 0)
(trans (nth 4 segment1) save_extrude 0)
(trans (nth 6 segment1) save_extrude 0)
(trans (nth 5 segment1) save_extrude 0)
trans_matrix
)
(setq 2dpoly_p_count (1+ 2dpoly_p_count))
) ; close progn
) ; close if
) ; close draw_fat
(defun draw_end (a b trans_matrix / a1 b1)
(setq a1
(trans
(list
(car a)
(cadr a)
(+ (caddr a) save_thickness)
)
save_extrude
0
)
)
(setq b1
(trans
(list
(car b)
(cadr b)
(+ (caddr b) save_thickness)
)
save_extrude
0
)
)
(setq a (trans a save_extrude 0))
(setq b (trans b save_extrude 0))
(draw_4 a b b1 a1 trans_matrix)
(setq 2dpoly_p_count (1+ 2dpoly_p_count))
) ; close draw_end
;;
;;
;; derive_wide
(defun derive_wide (v1 v2 width / seg_len delta_x delta_y)
(setq len_ratio (/ (/ width 2.0) (distance v1 v2)))
(setq delta_x (- (car v2) (car v1)))
(setq delta_y (- (cadr v2) (cadr v1)))
(list
(list
(+ (car v1) (* (- delta_y) len_ratio))
(+ (cadr v1) (* delta_x len_ratio))
(caddr v1)
)
(list
(+ (car v1) (* delta_y len_ratio))
(+ (cadr v1) (* (- delta_x) len_ratio))
(caddr v1)
)
)
)
(defun pre_process_poly ( / this_vertex next_vertex)
(setq segment_list nil)
(if (= (boole 1 1 (cdr (assoc 70 s))) 1) ;close polyline?
(setq closed_poly? T)
(setq closed_poly? nil)
)
(setq save_extrude (cdr (assoc 210 s)))
(setq e (entnext e))
(setq s (entget e (list "VIVID_RJH")))
;* save in case polyline is closed
(setq first_vertex s)
(setq this_vertex s)
(setq e (entnext e))
(setq s (entget e (list "VIVID_RJH")))
(setq next_vertex s)
(while
(/= (cdr (assoc 0 s)) "SEQEND")
(if (not (equal (cdr (assoc 10 this_vertex)) (cdr (assoc 10 next_vertex)) ))
(prep_poly this_vertex next_vertex)
)
(setq this_vertex s)
(setq e (entnext e))
(setq s (entget e (list "VIVID_RJH")))
(setq next_vertex s)
); close while
(if closed_poly?
(if (not (equal (cdr (assoc 10 this_vertex)) (cdr (assoc 10 first_vertex)) ))
(prep_poly this_vertex first_vertex)
)
)
)
(defun prep_poly ( this_vertex next_vertex / start_width end_width bulge temp a b c d)
(setq start_width (cdr (assoc 40 this_vertex)))
(setq end_width (cdr (assoc 41 this_vertex)))
(if (or (/= start_width 0)
(/= end_width 0)
)
;; wide polyline here -- need to draw
(setq draw_this_poly? T)
)
(if (/= (setq bulge (cdr (assoc 42 this_vertex))) 0)
;* arc here
;* if arc is greater than 180 degrees, it needs to be split
;* into to arcs
(if (<= (abs bulge) 1.0)
(progn
(setq segment_list
(append
segment_list
(list
(list
"arc"
(cdr (assoc 10 this_vertex))
(cdr (assoc 10 next_vertex))
bulge
start_width
) ; close list
) ; close list
) ; close append
) ; close setq
) ; close progn
(progn
(get_arc_params (cdr (assoc 10 this_vertex))
(cdr (assoc 10 next_vertex))
bulge
)
(setq v3 (list
(+ (car (cdr (assoc 10 this_vertex)))
(* (- (car arc_center) (car (cdr (assoc 10 this_vertex))))
2.0
)
)
(+ (cadr (cdr (assoc 10 this_vertex)))
(* (- (cadr arc_center) (cadr (cdr (assoc 10 this_vertex))))
2.0
)
)
(caddr (cdr (assoc 10 this_vertex)))
) ;close list
) ;close setq
(setq theta (atan bulge))
(if (< bulge 0 )
(setq theta (+ theta (/ pi 4.0)))
(setq theta (- theta (/ pi 4.0)))
)
(setq bulge (tan theta))
(setq segment_list
(append
segment_list
(list
(list
"arc"
(cdr (assoc 10 this_vertex))
v3
(/ bulge (abs bulge))
start_width
) ; close list
) ; close list
(list
(list
"arc"
v3
(cdr (assoc 10 next_vertex))
bulge
start_width
) ; close list
) ; close list
) ; close append
) ; close setq
) ; close progn
); close if
;* segment here- either fat or skinny
(if (or (/= start_width 0)
(/= end_width 0)
)
(progn
;** wide segment
(setq temp (derive_wide
(cdr (assoc 10 this_vertex ))
(cdr (assoc 10 next_vertex ))
start_width)
)
(setq a (car temp))
(setq b (cadr temp))
(setq temp (derive_wide
(cdr (assoc 10 next_vertex ))
(cdr (assoc 10 this_vertex ))
end_width)
)
(setq d (car temp))
(setq c (cadr temp))
(setq segment_list
(append
segment_list
(list
(list
"fat"
(cdr (assoc 10 this_vertex))
(cdr (assoc 10 next_vertex))
a
b
c
d
)
)
)
)
) ; close progn
;** skinny segment
(setq segment_list
(append
segment_list
(list
(list
"skinny"
(cdr (assoc 10 this_vertex))
(cdr (assoc 10 next_vertex))
)
)
)
)
) ; close if
) ; close if
) ; close prep_poly
(princ "loaded")
(princ)
